perm filename PLOUX.OLD[PIC,LCS] blob
sn#081722 filedate 1974-01-15 generic text, type T, neo UTF8
00100 SUBROUTINE PLOU
00200
00300 COMMON/PLT/JX,JY,JPL,PLT,REV,RINV,IROT,RLR,RUD,CONST
00400 1 ,JREV,JINV,KA,KB,KC,KD,RTO,JA,JB,JAR,JBR,A
00500
00600 DIMENSION IDP1(4000),INP(10,20)
00700
00800 COMMON /LISTC/LIST(6,1000),LIST5(0/1000),NEWEND,LO
00900 COMMON/COMMAC/BCLIP,TCLIP,BITS,IWID,LINLEN,FLINE,LLINE,
01000 1 LSIDE,RSIDE,DTA,HYSTAB(1)
01100 INTEGER FLINE,RSIDE
01200 DATA NEWX/0/,NCNT/0/
01300 RTO=6
01600 JPL=1
01700
01800 1001 FORMAT(A1,9F)
01900 1000 FORMAT(' D(ISPLAY) P(LOT) OR M(OVE)? HORIZ.%,VERT.%,
02000 1 FOR CLEAR AREA L-R-BOT-TOP% REV=1, INV=1'/)
02200 1 CALL JZERO
02210 JX=0
02220 JY=0
02240 NX=0
02270 NY=0
02300 TYPE 1000
02400 ACCEPT 1001,WHICH,RLR,RUD,A,B,C,D,REV,RINV,ROT
02500 IF(WHICH.NE.'T')GO TO 3002
02600 DO 4002 K=1,NCNT
02700 4002 TYPE 5002,(INP(NA,K),NA=1,10)
02800 GO TO 1000
02900 3002 IF(NCNT.LT.20.AND.WHICH.NE.WX)NCNT=NCNT+1
03000 REREAD 3,(INP(NA,NCNT),NA=1,10)
03100 WX=WHICH
03200 C SO IT WON'T COUNT RETRIES.
03300 3 FORMAT(10A5)
03400 5002 FORMAT(1X10A5)
03500 C FAC=SIZE BY 100'S, RLR=LEFT-RIGHT SIZE, RUD=UP-DOWN SIZE
03600 C-- D 0 0 0,50,0,50 CLEARS LOWER LFT QUAD. 50 100 50 100 UPR RT.
03700 C TYPE 'T' TO GET BACK ALL INPUT LINES.
03800 IF(A+B+C+D.EQ.0)A=-1.
03900 C 'N'= PLOT, BUT NO X
04000 IF(WHICH.EQ.'M')GO TO 2002
04100 IF(RLR.EQ.0)RLR=100.
04200 IF(RUD.EQ.0)RUD=100.
04300 IROT=-1
04400 IF(ROT.EQ.0)GO TO 2002
04500 IROT=0
04600 RINV=RINV-1
04700 2002 RLR=RLR/100.
04800 RUD=RUD/100.
04900 IF(WHICH.NE.'D')GO TO 1002
05000 PLT=0
05100 JPL=3
05200 C DPY IS 1/3 SIZE OF PLOT.
05300 GO TO 2000
05400
06000 1102 IF(WHICH.NE.'M')GO TO 1000
06200 C MOVE PEN, L-R%, U-D
06300 2200 RX=JQC-JQA+.5
06400 RY=JQD-JQB+.5
06500 NX=RX*RLR
06600 NY=RY*RUD
06700 RLR=.01
06800 RUD=.01
06900 GO TO 67
07000
07010 1002 IF(WHICH.NE.'P'.AND.WHICH.NE.'N')GO TO 1102
07032 PLT=1
07054 JPL=1
07076 IF(NEWX.NE.-1)CALL PLOTS(I)
07100 2 IF(WHICH.EQ.'N')GO TO 2000
07200 CALL PLOT(10,0,3)
07300 C MAKES AN X
07400 CALL PLOT(-10,0,2)
07500 CALL PLOT(0,10,3)
07600 CALL PLOT(0,-10,2)
07700 CALL PLOT(0,0,3)
07800
07900 2000 IF(NEWEND.GT.1000) PAUSE 'NEWEND>1000'
08000 C NEXT KEEPS ORIG. SIZE FACTORS
08100 50 FORMAT(' DO YOU WANT THE FRAME ?'/)
08200 IF(PLT.EQ.0)GO TO 67
08300 60 TYPE 50
08400 65 FORMAT(' LFT=',I4,' RT=',I4,' BOT=',I4,' TOP=',I4)
08500 ACCEPT 1001,ALFAB
08600 67 RA=LSIDE*(RTO*RLR)+.5
08700 RB=FLINE*(RTO*RUD)+.5
08800 RC=RSIDE*(RTO*RLR)+.5
08900 RD=LLINE*(RTO*RUD)+.5
09000 IF(NEWX.EQ.-1)GO TO 655
09100 JQA=RA
09200 JQB=RB
09300 JQC=RC
09400 JQD=RD
09500 655 JQX=NX
09600 JQY=NY
09700 NY=NY+120-RB
09800 NX=NX+36-RA
09900 C "ORIGINAL" POS IS SET 1ST TIME ONLY.
10000 JA=RA+NX
10100 JB=RB+NY
10200 JC=RC+NX
10300 JD=RD+NY
10400 IF(WHICH.EQ.'M')GO TO 671
10500 TYPE 657
10600 657 FORMAT(' OUTER LIMITS')
10700 TYPE 65,JA,JC,JB,JD
10800 C OUTER COORDINATES
10900 JREV=(JA+JC)/JPL
11000 JINV=(JB+JD)/JPL
11100 KA=0
11200 KB=0
11300 KC=0
11400 KD=0
11500 IF(A)GO TO 671
11600 KA=JA+(JC-JA)*(A/100.)
11700 KB=JA+(JC-JA)*(B/100.)
11800 KC=JB+(JD-JB)*(C/100.)
11900 KD=JB+(JD-JB)*(D/100.)
12000 IF(KB.LT.KA.OR.KD.LT.KC)GO TO 1
12100 TYPE 656
12200 656 FORMAT(/' CLEAR AREA')
12300 TYPE 65,KA,KB,KC,KD
12400 C CLEAR AREA COORDINATES
12500 671 NA=(JC-JA+2)/3
12600 NB=(JD-JB+2)/3
12700 NC=(JA+2)/3-380
12800 ND=(JB+2)/3-200
12900 IF(NEWX.NE.-1)CALL DPYSET(1,IDP1,4000)
13000 CALL SETPOG(1)
13100 CALL TYPLOC(-300,-611)
13200 CALL DPYBRT(6)
13250 CALL AIVECT(0,0)
13300 MA=JA
13400 MB=JB
13460 JA=NC
13470 JB=ND
13500 IF(IROT)GO TO 672
13600 NC=NX+JA-JB
13700 NX=NY+JB-JA
13750 NY=NC
13800 CC JY=NY/JPL
13850 CC JX=NX/JPL
13875 CALL EXCH(JA,JB)
13900 C ROTATE THE FRAME TO LEFT 90 DEG.
14000 672 CALL LINES(3)
14100 CALL JZERO
14300 JA=NA
14400 JB=0
14500 CALL LINES(2)
14600 JA=0
14700 JAR=0
14800 JB=NB
14900 CALL LINES(2)
15000 JA=-NA
15100 JB=0
15200 JBR=0
15300 CALL LINES(2)
15400 JA=0
15500 JAR=0
15600 JB=-NB
15700 CALL LINES(2)
15800 JA=MA
15900 JB=MB
16000 JBR=0
16100 CALL DPYOUT(1)
16200 IF(WHICH.NE.'M')GO TO 2683
16300 168 NY=JQY
16400 NX=JQX
16500 GO TO 1
16600 2683 IF(A)GO TO 1683
16700 NA=KA/3-380
16800 NB=KB/3-380
16900 NC=KC/3-200
17000 ND=KD/3-200
17050 GO TO 4683
17100 NPL=1
17200 IF(JPL.EQ.1)NPL=3
17300 IF(REV.EQ.0)GO TO 3683
17400 NA=JREV/NPL-NA
17500 NB=JREV/NPL-NB
17600 3683 IF(RINV.EQ.0)GO TO 4683
17700 NC=JINV/NPL-NC
17800 ND=JINV/NPL-ND
17900 4683 CALL DPYSET(2,LIST5,100)
18000 CALL DPYBRT(2)
18110 JA=NA
18120 JB=NB
18130 JAR=NC
18140 JBR=ND
18200 CALL LINES(0)
18310 JA=NB
18320 JB=ND
18330 CALL LINES(2)
18335 CALL JZERO
18340 JA=NA
18400 CALL LINES(2)
18500 CALL JZERO
18510 JB=NC
18520 CALL LINES(2)
18600 CALL JZERO
19100 6683 CALL DPYOUT(2)
19150 IF(PLT.NE.0)JPL=1
19200 KA=KA/JPL
19300 KB=KB/JPL
19400 KC=KC/JPL
19500 KD=KD/JPL
19600 1683 TYPE 683
19700 683 FORMAT(' OK?'/)
19800 ACCEPT 1001,NA
19900 IF(NA.EQ.'N')GO TO 168
20000 IF(PLT.NE.0)GO TO 1681
20100 682 CALL CLRPOG(2)
20200 CALL SETPOG(1)
20300 JA=-380
20400 JB=-200
20410 CALL JZERO
20520 CALL AIVECT(0,0)
20620 IF(IROT.EQ.0)CALL EXCH(JA,JB)
20800 684 CALL LINES(3)
20900 681 GO TO 68
20950 1681 PLT=-1
21000 IF(ALFAB.EQ.'N') GOTO 68
21060 JA=MA
21080 JB=MB
21100 NA=JA
21200 NB=JB
21300 CALL LINES(3)
21400 JA=JC
21500 CALL LINES(2)
21600 JB=JD
21700 CALL LINES(2)
21800 JA=NA
21900 CALL LINES(2)
22000 JB=NB
22100 CALL LINES(2)
22200 68 IF(IROT)GO TO 685
22300 NA=(JC-MA)/2-(JD-MB)/2
22400 NX=NX+NA
22500 NY=NY+NA
22600 CALL EXCH(NX,NY)
22700 685 JX=NX/JPL
22800 NEWX=-1
22900 JY=NY/JPL
22910 JA=MA
22920 JB=MB
22930 JAR=0
22940 JBR=0
23000 CALL PLTMAN
23100 NX=JQX
23200 NY=JQY
23300 WX=0
23400 END